home *** CD-ROM | disk | FTP | other *** search
/ Alde ADA 5 #1 / ADA CD-ROM - Alde Publishing.iso / pieces / namelist.src < prev    next >
Encoding:
Text File  |  1988-05-03  |  20.9 KB  |  882 lines

  1. ::::::::::
  2. nlg.ada
  3. ::::::::::
  4.  
  5. ---- NLG.ADA
  6. -- This package is a generic package of
  7. -- generic procedures, where a generic formal parameter of the
  8. -- generic package is a generic formal parameter of the generic
  9. -- function.  This package implements a namelist function in ADA.
  10. -- The data is read in from a user defined file and stored in
  11. -- a character array(VAR_ARRAY). This array is indexed
  12. -- by a enumerated type which is the name of the
  13. -- variable with VAL tacked on to the end.  The initialization of
  14. -- VAR_ARRAY is done by the procedure INIT_NAMELIST.
  15. -- The data is transfered to the program
  16. -- variables by the generic procedures GET_VAL
  17. -- and GET_VAL_V.  GET_VALUE is not a generic procedure and
  18. -- reads in data of predefined type STRING.
  19. -- Vectors and two dimensional arrays can be read in.
  20. -- NL_PRINT_FLAG controls the print out: if NL_PRINT_FLAG = 1 the
  21. -- data lines will be sent to the current output device as
  22. -- they are read in.  In addition, the values as they are
  23. -- stored in VAR_ARRAY are printed out.
  24. --
  25. -- Written by David Kwong...finished 10/86
  26. -- 11/86 changed FILE_NAME to NAMELIST_FILE_NAME and
  27. --       moved declaration to package specification
  28.  
  29.     WITH TEXT_IO; USE TEXT_IO;
  30.     WITH INTEGER_TEXT_IO;
  31. GENERIC
  32.     TYPE VAR IS (<>);
  33.     WITH PROCEDURE GET(FROM: IN STRING; ITEM: OUT VAR;
  34.         LAST: OUT POSITIVE) IS <>;
  35. PACKAGE NAMELIST_GENERIC IS
  36.  
  37.     -- Define Global Variables
  38.     SUBTYPE INSTRING IS STRING(1..120);
  39.     NAMELIST_FILE_NAME: STRING(1..30) :="                              ";
  40.     TYPE VAR_ARRAY_T IS ARRAY (VAR) OF INSTRING;
  41.     VAR_ARRAY:VAR_ARRAY_T; -- Array containing all all the data
  42.     NL_PRINT_FLAG : INTEGER := 0; -- Flag controlling
  43.                                   -- printing of information
  44.     -- This constant string is used to check if a value has
  45.     -- been changed.  This string cannot be used as an
  46.     -- input to the namelist.
  47.     NOT_CHANGED: CONSTANT STRING(1..3):=(ASCII.FF,
  48.                                           ASCII.ESC,ASCII.FF);
  49.  
  50. -- Procedure used to initialized VAR_ARRAY with values from the
  51. -- input file
  52.  
  53.     PROCEDURE INIT_NAMELIST(FNAME: IN STRING := NOT_CHANGED);
  54.  
  55. -- Function used to read strings from the namelist
  56.  
  57.     PROCEDURE GET_VALUE (OUT_STRING: IN OUT STRING; INDEX: IN VAR);
  58.  
  59. -- Generic procedure used to read integer, floating point
  60. -- and enumerated types from the namelist.
  61.  
  62.     GENERIC
  63.         TYPE OUT_VAL IS PRIVATE;
  64.         WITH PROCEDURE GET(FROM: IN INSTRING; ITEM: OUT OUT_VAL;
  65.                            LAST: OUT POSITIVE) IS <>;
  66.     PROCEDURE GET_VAL (VALUE: IN OUT OUT_VAL; INDEX: IN VAR);
  67.  
  68. -- Generic procedure used to read 1 dimensional arrays or vectors
  69. -- from the namelist
  70.  
  71.     GENERIC
  72.         TYPE COMP_TYPE IS PRIVATE;
  73.         TYPE VINDEX IS (<>);
  74.         TYPE VECT IS ARRAY (VINDEX RANGE <>) OF COMP_TYPE;
  75.         WITH PROCEDURE GET(FROM: IN INSTRING; ITEM: OUT COMP_TYPE;
  76.                            LAST: OUT POSITIVE) IS <>;
  77.     PROCEDURE GET_VAL_V (OUT_VECT: IN OUT VECT; INDEX: IN VAR);
  78.  
  79. -- Generic procedure used to read 2 dimensional arrays or matrices
  80. -- from the namelist
  81.  
  82.     GENERIC
  83.         TYPE COMP_TYPE IS PRIVATE;
  84.         TYPE MINDEX IS (<>);
  85.         TYPE MATRIX IS ARRAY (MINDEX RANGE <>, MINDEX RANGE <>)
  86.                                      OF COMP_TYPE;
  87.         WITH PROCEDURE GET(FROM: IN INSTRING; ITEM: OUT COMP_TYPE;
  88.                            LAST: OUT POSITIVE) IS <>;
  89.     PROCEDURE GET_VAL_M (OUT_MAT: IN OUT MATRIX; INDEX: IN VAR);
  90.  
  91. END NAMELIST_GENERIC;
  92.  
  93.  
  94. PACKAGE BODY NAMELIST_GENERIC IS
  95.  
  96. -- This procedure  will read a file and initialize the data array used in
  97. -- the package NAMELIST_GENERIC.
  98.  
  99.     PROCEDURE INIT_NAMELIST(FNAME: IN STRING := NOT_CHANGED) IS
  100.  
  101.         USE INTEGER_TEXT_IO;
  102.  
  103.         CVAL: INSTRING;
  104.         DATALINE: STRING(1..132); -- Max size of line in input file
  105.         INDEX: VAR; -- Emumerated type which indexes VAR_ARRAY
  106.         LAST: INTEGER;
  107.         LASTJ: INTEGER; -- Last value of index J in string CVAL
  108.         NL_FILE: FILE_TYPE;
  109.         NLINES: INTEGER := 0;
  110.         NCHAR: INTEGER;-- Total number of characters in input line
  111.         NCHARD: INTEGER; -- Number of data
  112.                          -- characters in input DATALINE
  113.         NROWS: INTEGER := 1; -- Number of rows in two
  114.                              -- dimensional matrix
  115.         INDEXS: INTEGER :=1; -- Index of beginning
  116.                              -- of matrix data element
  117.  
  118.     BEGIN
  119.  
  120.         IF(FNAME(1..3) = NOT_CHANGED) THEN
  121.             PUT("PLEASE ENTER NAME OF NAME LIST FILE: ");
  122.             GET_LINE(NAMELIST_FILE_NAME,NCHAR);
  123.             NEW_LINE;
  124.         ELSE
  125.             NCHAR := FNAME'LAST;
  126.             NAMELIST_FILE_NAME(1..NCHAR) := FNAME;
  127.         END IF;
  128.  
  129.         OPEN(FILE=>NL_FILE, MODE=>IN_FILE,
  130.             NAME=>NAMELIST_FILE_NAME(1..NCHAR));
  131.  
  132.         -- Initialize VAR_ARRAY 
  133.         FOR II IN VAR_ARRAY'RANGE LOOP
  134.             VAR_ARRAY(II)(1..3) := NOT_CHANGED;
  135.         END LOOP;
  136.  
  137.         FOR I IN 1..200 LOOP -- reads up to 200 entries
  138.  
  139.             IF(END_OF_FILE(NL_FILE)) THEN
  140.                 EXIT;
  141.             END IF;
  142.             NLINES := NLINES + 1;
  143.  
  144.             -- INITIALIZE DATALINE
  145.             FOR I IN DATALINE'RANGE LOOP
  146.                 DATALINE(I) := ' ';
  147.             END LOOP;
  148.             -- Read line from input file
  149.             GET_LINE(NL_FILE,DATALINE,NCHARD);
  150.             -- Look for comments
  151.             FOR I IN 2..NCHARD LOOP
  152.                 IF((DATALINE(I)='-') AND (DATALINE(I-1)='-')) THEN
  153.                     NCHARD := I-2; -- NCHARD = 0 is ok
  154.                     EXIT;
  155.                 END IF;
  156.             END LOOP;
  157.  
  158.             IF(NL_PRINT_FLAG = 1) THEN
  159.                 NEW_LINE;
  160.                 PUT (DATALINE(1..NCHARD));
  161.             END IF;
  162.  
  163.             -- PARSE STRING AND INPUT INTO ARRAY
  164.  
  165.             FOR I IN 1..NCHARD LOOP
  166.  
  167.                 -- Check to see if variable is matrix
  168.                 IF (DATALINE(I) = '(') THEN
  169.  
  170.                     GET(DATALINE(1..I-1),INDEX,NCHAR); -- Get index
  171.  
  172.                     FOR J IN I..NCHARD LOOP
  173.  
  174.                         IF(DATALINE(J) = ',')THEN -- Get num of rows
  175.                             GET(DATALINE((I+1)..(J-1)),NROWS,LAST);
  176.                         END IF;
  177.  
  178.                         -- read in first line of data
  179.                         IF (DATALINE(J) = '=') THEN -- Look for "="
  180.                             FOR K IN J+1..NCHARD LOOP
  181.                                 CVAL(K-J) := DATALINE(K);
  182.                             END LOOP;
  183.                             LASTJ := NCHARD-J; -- Last used pos in CVAL
  184.                             EXIT;
  185.                         END IF;
  186.  
  187.                     END LOOP;
  188.  
  189.                     -- Read in additional datalines for matrix
  190.                     -- Loop on number of rows-1 in matrix
  191.                     FOR K IN 1..NROWS-1 LOOP
  192.  
  193.                         -- INITIALIZE DATALINE
  194.                         FOR I IN DATALINE'RANGE LOOP
  195.                             DATALINE(I) := ' ';
  196.                         END LOOP;
  197.                         -- Read line from input file
  198.                         GET_LINE(NL_FILE,DATALINE,NCHARD);
  199.                         IF(NL_PRINT_FLAG = 1) THEN
  200.                             NEW_LINE;
  201.                             PUT (DATALINE(1..NCHARD));
  202.                         END IF;
  203.  
  204.                         INDEXS :=1;
  205.                         FOR I IN 2..NCHARD LOOP
  206.                             -- Look for comments
  207.                             IF((DATALINE(I)='-') AND
  208.                                (DATALINE(I-1)='-')) THEN
  209.                                 NCHARD := I-2; -- NCHARD = 0 is ok
  210.                                 EXIT;
  211.                             END IF;
  212.                             -- Find beginning of data strip
  213.                             -- leading blanks and tabs
  214.                             IF(INDEXS = 1 AND DATALINE(I) /=' '
  215.                                 AND DATALINE(I) /= ASCII.HT) THEN
  216.                                 INDEXS :=I;
  217.                             END IF;
  218.                         END LOOP;
  219.  
  220.                         -- Make sure data can fit in CVAL
  221.                         IF(CVAL'LAST>=LASTJ+NCHARD-INDEXS+1) THEN
  222.                             FOR J IN INDEXS..NCHARD LOOP
  223.                                 CVAL(J+LASTJ-INDEXS+1):= DATALINE(J);
  224.                             END LOOP;
  225.                             LASTJ := NCHARD-INDEXS+1+LASTJ;
  226.                         ELSE
  227.                             NEW_LINE;
  228.                             PUT(" DATALINE FOR MATRIX TOO LONG");
  229.                             NEW_LINE;
  230.                             PUT("FIX BY INCREASING CVAL'LAST");
  231.                             RAISE CONSTRAINT_ERROR;
  232.                         END IF;
  233.  
  234.                     END LOOP;
  235.  
  236.                     -- Pad with blanks
  237.                     FOR J IN LASTJ+1..CVAL'LAST LOOP
  238.                         CVAL(J) := ' ';
  239.                     END LOOP;
  240.  
  241.                     -- Put read in data into VAR_ARRAY
  242.                     VAR_ARRAY(INDEX) := CVAL;
  243.                     IF(NL_PRINT_FLAG = 1) THEN
  244.                         NEW_LINE;
  245.                         PUT(" CVAL =");
  246.                         PUT(CVAL);
  247.                     END IF;
  248.                     EXIT;
  249.  
  250.                 ELSIF (DATALINE(I) = '=') THEN -- Look for "="
  251.  
  252.                     GET(DATALINE(1..I-1),INDEX,NCHAR); -- Get index
  253.                     IF (CVAL'LAST <= NCHARD-I) THEN
  254.                         -- Read in data for value when input data
  255.                         -- is greater than CVAL print out warning
  256.                         NEW_LINE;
  257.                         PUT("INPUT LINE IS TOO LARGE");
  258.                         PUT("FOR VALUE: ");PUT(DATALINE(1..I-1));
  259.                         NEW_LINE; PUT("TRUNCATING AND CONTINUING");
  260.                         NEW_LINE;
  261.                         PUT("FIX BY INCREASING CVAL'LAST");
  262.                         FOR J IN CVAL'RANGE LOOP
  263.                             CVAL(J):=DATALINE(I+J);
  264.                         END LOOP;
  265.                     ELSE
  266.                         -- Read in data for value when input data
  267.                         -- is smaller than CVAL
  268.                         FOR J IN 1..NCHARD-I LOOP
  269.                             CVAL(J):=DATALINE(I+J);
  270.                         END LOOP;
  271.                         -- Pad with blanks
  272.                         FOR J IN NCHARD-I+1..CVAL'LAST LOOP
  273.                             CVAL(J) := ' ';
  274.                         END LOOP;
  275.                     END IF;
  276.  
  277.                     -- Put read in data into VAR_ARRAY
  278.                     VAR_ARRAY(INDEX) := CVAL;
  279.                     IF(NL_PRINT_FLAG = 1) THEN
  280.                         NEW_LINE;
  281.                         PUT(" CVAL =");
  282.                         PUT(CVAL);
  283.                     END IF;
  284.                     EXIT;
  285.  
  286.                 END IF;
  287.  
  288.             END LOOP;
  289.  
  290.         END LOOP;
  291.  
  292.         CLOSE(NL_FILE);
  293.  
  294.         IF(NL_PRINT_FLAG = 1) THEN
  295.             NEW_LINE;
  296.             PUT(NLINES);
  297.             PUT("  LINES READ INTO NAMELIST");
  298.             NEW_LINE;
  299.         END IF;
  300.     EXCEPTION
  301.         WHEN DATA_ERROR =>
  302.             NEW_LINE(STANDARD_OUTPUT);
  303.             PUT(STANDARD_OUTPUT," ERROR IN NAME LIST: ");
  304.             PUT(STANDARD_OUTPUT," VARIABLE NAME NOT CORRECT?(xxxVAL)");
  305.             RAISE;
  306.         WHEN OTHERS =>
  307.             RAISE;
  308.  
  309.     END INIT_NAMELIST;
  310.  
  311.  
  312. -- This procedure reads in strings to string variables
  313.  
  314.     PROCEDURE GET_VALUE (OUT_STRING: IN OUT STRING; INDEX: IN VAR) IS
  315.  
  316.         Q1,Q2:INTEGER := 0;
  317.         DINDEX: INTEGER;
  318.         DATA: INSTRING := VAR_ARRAY(INDEX);
  319.  
  320.     BEGIN
  321.  
  322.         -- Check to see if value has been changed
  323.         IF(VAR_ARRAY(INDEX)(1..3) = NOT_CHANGED) THEN
  324.             RETURN;
  325.         END IF;
  326.  
  327.         -- Find the quotes
  328.         FOR I IN INSTRING'RANGE LOOP
  329.             IF(DATA(I) = '"') THEN
  330.                 IF(Q1 = 0) THEN
  331.                     Q1 := I;
  332.                 ELSE
  333.                     Q2 := I;
  334.                 END IF;
  335.             END IF;
  336.         END LOOP;
  337.         -- Place characters between quotes into out string.
  338.         -- If out string is too short, characters are truncated
  339.         -- from right side.  If out string is too long, blanks
  340.         -- are added to right side.
  341.         DINDEX := Q1;
  342.         FOR I IN OUT_STRING'RANGE LOOP
  343.             DINDEX := DINDEX+1;
  344.             IF((DINDEX) >= Q1) AND (DINDEX < Q2 ) THEN
  345.                 OUT_STRING(I) := DATA(DINDEX);
  346.             ELSE
  347.                 OUT_STRING(I) := ' ';
  348.             END IF;
  349.         END LOOP;
  350.  
  351.     EXCEPTION
  352.  
  353.         WHEN DATA_ERROR =>
  354.             NEW_LINE(STANDARD_OUTPUT);
  355.             PUT(STANDARD_OUTPUT," ERROR IN NAME LIST INPUT DATA: ");
  356.             PUT(STANDARD_OUTPUT," CHECK SYNTAX OF INPUT FILE");
  357.             RAISE;
  358.         WHEN OTHERS =>
  359.             RAISE;
  360.  
  361.     END GET_VALUE;
  362.  
  363.  
  364. -- This generic procedure can be instantiated for integer, float
  365. -- and enumerated
  366. -- types.  "GET" for that type must be defined as a generic parameter.
  367.  
  368.     PROCEDURE GET_VAL (VALUE: IN OUT OUT_VAL; INDEX: IN VAR) IS
  369.  
  370.         LAST:POSITIVE;
  371.  
  372.     BEGIN
  373.  
  374.         -- Check to see if value has been changed
  375.         IF(VAR_ARRAY(INDEX)(1..3) = NOT_CHANGED) THEN
  376.             RETURN;
  377.         END IF;
  378.  
  379.         GET(VAR_ARRAY(INDEX),VALUE,LAST);
  380.  
  381.     EXCEPTION
  382.  
  383.         WHEN DATA_ERROR =>
  384.             NEW_LINE(STANDARD_OUTPUT);
  385.             PUT(STANDARD_OUTPUT," ERROR IN NAME LIST INPUT DATA: ");
  386.             PUT(STANDARD_OUTPUT," CHECK SYNTAX OF INPUT FILE");
  387.             RAISE;
  388.         WHEN OTHERS =>
  389.             RAISE;
  390.  
  391.     END GET_VAL;
  392.  
  393.  
  394. -- This generic procedure is used to read in the values for a one
  395. -- dimensional array or vector.
  396.  
  397.     PROCEDURE GET_VAL_V (OUT_VECT: IN OUT VECT; INDEX: IN VAR) IS
  398.  
  399.         C1,C2:INTEGER := 1;
  400.         LAST : INTEGER;
  401.         DATA: INSTRING := VAR_ARRAY(INDEX);
  402.         VALUE: COMP_TYPE;
  403.  
  404.     BEGIN
  405.  
  406.         -- Check to see if value has been changed
  407.         IF(VAR_ARRAY(INDEX)(1..3) = NOT_CHANGED) THEN
  408.             RETURN;
  409.         END IF;
  410.  
  411.         -- Find the commas
  412.         FOR M IN OUT_VECT'RANGE LOOP
  413.             FOR I IN C1..DATA'LAST LOOP
  414.                 IF M = OUT_VECT'LAST THEN
  415.                     C2 := DATA'LAST;
  416.                     EXIT;
  417.                 END IF;
  418.                 IF(DATA(I) = ',') THEN
  419.                     C2 := I-1;
  420.                     EXIT;
  421.                 END IF;
  422.             END LOOP;
  423.  
  424.             -- Place characters between commas into the correct
  425.             -- element of the vector 
  426.             GET(VAR_ARRAY(INDEX)(C1..C2),VALUE,LAST);
  427.  
  428.             OUT_VECT(M) := VALUE;
  429.  
  430.             C1 := C2+2;
  431.  
  432.         END LOOP;
  433.  
  434.     EXCEPTION
  435.  
  436.         WHEN DATA_ERROR =>
  437.             NEW_LINE(STANDARD_OUTPUT);
  438.             PUT(STANDARD_OUTPUT," ERROR IN NAME LIST INPUT DATA: ");
  439.             PUT(STANDARD_OUTPUT," CHECK SYNTAX OF INPUT FILE");
  440.             RAISE;
  441.         WHEN OTHERS =>
  442.             RAISE;
  443.  
  444.     END GET_VAL_V;
  445.  
  446.  
  447. -- This generic procedure is used to read in the values for a two
  448. -- dimensional array or matrix.
  449.  
  450.     PROCEDURE GET_VAL_M (OUT_MAT: IN OUT MATRIX; INDEX: IN VAR) IS
  451.  
  452.         C1,C2:INTEGER := 1;
  453.         LAST : INTEGER;
  454.         DATA: INSTRING := VAR_ARRAY(INDEX);
  455.         VALUE: COMP_TYPE;
  456.  
  457.     BEGIN
  458.  
  459.         -- Check to see if value has been changed
  460.         IF(VAR_ARRAY(INDEX)(1..3) = NOT_CHANGED) THEN
  461.             RETURN;
  462.         END IF;
  463.  
  464.         -- Find the commas and place into correct part of matrix
  465.         FOR I IN OUT_MAT'RANGE(1) LOOP -- Loop on rows
  466.             FOR J IN OUT_MAT'RANGE(2) LOOP -- Loop on columns
  467.  
  468.                 FOR K IN C1..DATA'LAST LOOP
  469.                     IF (I = OUT_MAT'LAST(1)) AND -- Pick up last value
  470.                        (J = OUT_MAT'LAST(2)) THEN
  471.                         C2 := DATA'LAST;
  472.                         EXIT;
  473.                     END IF;
  474.                     IF(DATA(K) = ',') THEN
  475.                         C2 := K-1;
  476.                         EXIT;
  477.                     END IF;
  478.                 END LOOP;
  479.  
  480.                 -- Place characters between commas into the correct
  481.                 -- element of the matrix
  482.                 GET(VAR_ARRAY(INDEX)(C1..C2),VALUE,LAST);
  483.  
  484.                 OUT_MAT(I,J) := VALUE;
  485.  
  486.                 C1 := C2+2;
  487.  
  488.             END LOOP;
  489.  
  490.         END LOOP;
  491.  
  492.     EXCEPTION
  493.  
  494.         WHEN DATA_ERROR =>
  495.             NEW_LINE(STANDARD_OUTPUT);
  496.             PUT(STANDARD_OUTPUT," ERROR IN NAME LIST INPUT DATA: ");
  497.             PUT(STANDARD_OUTPUT," CHECK SYNTAX OF INPUT FILE");
  498.             RAISE;
  499.         WHEN OTHERS =>
  500.             RAISE;
  501.  
  502.  
  503.     END GET_VAL_M;
  504.  
  505.  
  506. END NAMELIST_GENERIC;
  507. ::::::::::
  508. tnl.ada
  509. ::::::::::
  510.  
  511. ---  TNL.ADA
  512. -- This program tests the name list PROCEDUREs
  513. -- by instantiating the file NLG.ADA
  514.  
  515.     WITH NAMELIST_GENERIC;
  516.     WITH TEXT_IO; USE TEXT_IO;
  517.     WITH INTEGER_TEXT_IO; USE INTEGER_TEXT_IO;
  518.     WITH FLOAT_TEXT_IO; USE FLOAT_TEXT_IO;
  519.  
  520. PROCEDURE TNL IS
  521.  
  522.     TYPE VAR IS
  523.      (FYVAL,IVAL,M1VAL,M2VAL,M3VAL,M4VAL,MIVAL
  524.      ,TITLE1VAL,TITLE2VAL,TITLE3VAL,V1VAL
  525.      ,V12VAL,V2VAL,V3VAL,V4VAL,VACVAL,XVAL,YVAL);
  526.  
  527.     PACKAGE ENUM_IO IS NEW ENUMERATION_IO(VAR);
  528.     USE ENUM_IO;
  529.  
  530.     PACKAGE NL IS NEW NAMELIST_GENERIC(VAR);
  531.     USE NL;
  532.  
  533. -- test enumerated type
  534.  
  535.     TYPE DAYS IS (MON,TUES,WED,THUR,FRI,SAT,SUN);
  536.  
  537.     PACKAGE DAYS_IO IS NEW ENUMERATION_IO(DAYS);
  538.     USE DAYS_IO;
  539.  
  540. -- Test Fixed point type
  541.  
  542.     TYPE FIXED IS DELTA 2.0 RANGE -20.0..18.0;
  543.  
  544.     PACKAGE FIXED_TEXT_IO IS NEW FIXED_IO(FIXED);
  545.     USE FIXED_TEXT_IO;
  546.  
  547. -- Vector types
  548.     TYPE VECTOR_F IS ARRAY(INTEGER RANGE <> ) OF FLOAT;
  549.     TYPE VECTOR_E IS ARRAY(DAYS RANGE <> ) OF FLOAT;
  550.     TYPE VECTOR_D IS ARRAY(INTEGER RANGE <> ) OF DAYS;
  551.  
  552. -- Matrix types
  553.     TYPE MATRIX_F IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF FLOAT;
  554.     TYPE MATRIX_I IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF INTEGER;
  555.     TYPE MATRIX_E IS ARRAY(DAYS RANGE <>, DAYS RANGE <>) OF FLOAT;
  556.     TYPE MATRIX_D IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF DAYS;
  557.  
  558. -- Instantiate procedures for scalar types
  559.     PROCEDURE GET_VALUE IS NEW GET_VAL(DAYS);
  560.     PROCEDURE GET_VALUE IS NEW GET_VAL(FLOAT);
  561.     PROCEDURE GET_VALUE IS NEW GET_VAL(FIXED);
  562.     PROCEDURE GET_VALUE IS NEW GET_VAL(INTEGER);
  563.  
  564. -- Instantiate procedures for vector types
  565.     PROCEDURE GET_VALUE IS NEW GET_VAL_V(FLOAT,INTEGER,VECTOR_F);
  566.     PROCEDURE GET_VALUE IS NEW GET_VAL_V(FLOAT,DAYS,VECTOR_E);
  567.     PROCEDURE GET_VALUE IS NEW GET_VAL_V(DAYS,INTEGER,VECTOR_D);
  568.  
  569. -- Instantiate procedures for 2 dimensional array types
  570.     PROCEDURE GET_VALUE IS NEW GET_VAL_M(FLOAT,INTEGER,MATRIX_F);
  571.     PROCEDURE GET_VALUE IS NEW GET_VAL_M(INTEGER,INTEGER,MATRIX_I);
  572.     PROCEDURE GET_VALUE IS NEW GET_VAL_M(FLOAT,DAYS,MATRIX_E);
  573.     PROCEDURE GET_VALUE IS NEW GET_VAL_M(DAYS,INTEGER,MATRIX_D);
  574.  
  575.     Y,X:FLOAT:= 0.0;
  576.     I:INTEGER:= 0;
  577.     VAC: DAYS:= FRI;
  578.     FY:FIXED := 4.0;
  579.  
  580.     V1:VECTOR_F(1..5);
  581.     V2:VECTOR_F(-1..1);
  582.     V3:VECTOR_E(MON..FRI);
  583.     V4:VECTOR_D(3..5);
  584.  
  585.     M1:MATRIX_F(1..3,1..3);
  586.     M2:MATRIX_F(1..2,-1..1);
  587.     MI:MATRIX_I(-1..0,-1..0);
  588.     M3:MATRIX_E(THUR..FRI,WED..FRI);
  589.     M4:MATRIX_D(0..2,-1..0);
  590.  
  591.  
  592.     TITLE1: STRING(1..10);
  593.     TITLE2: STRING(1..22):=" Whats your problem?!!";
  594.     TITLE3: STRING(1..40);
  595.  
  596.     FNAME: STRING(1..30);
  597.     OUTFILE: FILE_TYPE;
  598.     NCHAR: INTEGER;
  599.  
  600. BEGIN
  601.  
  602. -- READ IN DATA FROM FILE AND INITIALIZE THE DATA ARRAY
  603.     NL_PRINT_FLAG := 1;
  604.     INIT_NAMELIST;
  605.  
  606. -- Open up output file
  607.     NEW_LINE;
  608.     PUT("PLEASE ENTER NAME OF OUTPUT FILE: ");
  609.     GET_LINE(FNAME,NCHAR);
  610.     NEW_LINE;
  611.     CREATE(FILE=>OUTFILE, MODE=> OUT_FILE, NAME=> FNAME(1..NCHAR));
  612.     SET_OUTPUT(OUTFILE);
  613.  
  614.     NEW_LINE(2);
  615.     PUT("THIS IS A TEST: The following are the translated values");
  616.     NEW_LINE(2);
  617.  
  618. -- Floating point scalars
  619.     GET_VALUE(X,XVAL);
  620.     PUT("X:FLOAT TYPE=");
  621.     PUT(X);
  622.  
  623.     NEW_LINE(2);
  624.     GET_VALUE(Y,YVAL);
  625.     PUT("Y: FLOAT TYPE=");
  626.     PUT(Y);
  627.  
  628. -- Fixed point scalar
  629.     NEW_LINE(2);
  630.     GET_VALUE(FY,FYVAL);
  631.     PUT("FY: FIXED POINT  TYPE=");
  632.     PUT(FY);
  633.  
  634. -- Integer scalar
  635.     NEW_LINE(2);
  636.     GET_VALUE(I,IVAL);
  637.     PUT("I: INTEGER TYPE=");
  638.     PUT(I);
  639.  
  640. -- Enumerated scalar
  641.     NEW_LINE(2);
  642.     GET_VALUE(VAC,VACVAL);
  643.     PUT("VAC: ENUMERATION TYPE=");
  644.     PUT(VAC);
  645.  
  646. -- Strings
  647.     NEW_LINE(2);
  648.     GET_VALUE(TITLE1,TITLE1VAL);
  649.     PUT("TITLE1(STRING(1..10))=");
  650.     PUT(TITLE1);
  651.  
  652.     NEW_LINE(2);
  653.     GET_VALUE(TITLE2,TITLE2VAL);
  654.     PUT("TITLE2(STRING)(DEFAULT VALUE)=");
  655.     PUT(TITLE2);
  656.  
  657.     NEW_LINE(2);
  658.     GET_VALUE(TITLE3,TITLE3VAL);
  659.     PUT("TITLE3: STRING(1..40)=");
  660.     PUT(TITLE3);
  661.  
  662. -- Floating point element of vector
  663.     NEW_LINE(2);
  664.     GET_VALUE(V1(2),V12VAL);
  665.     PUT("V1(2):ELEMENT OF VECTOR=");
  666.     NEW_LINE;
  667.     PUT(V1(2));
  668.  
  669. -- Floating point vectors
  670.     NEW_LINE(2);
  671.     GET_VALUE(V1,V1VAL);
  672.     PUT("V1: VECTOR(1..5) OF FLOAT TYPE=");
  673.     NEW_LINE;
  674.     FOR K IN V1'RANGE LOOP
  675.         PUT(V1(K));
  676.     END LOOP;
  677.  
  678.  
  679.     NEW_LINE(2);
  680.     GET_VALUE(V2,V2VAL);
  681.     PUT("V2: VECTOR(-1..1) OF FLOAT TYPE=");
  682.     NEW_LINE;
  683.     FOR K IN V2'RANGE LOOP
  684.         PUT(V2(K));
  685.     END LOOP;
  686.  
  687. -- Vector indexed by enumerated type of floating point
  688.     NEW_LINE(2);
  689.     GET_VALUE(V3,V3VAL);
  690.     PUT("V3: VECTOR(MON..FRI) OF FLOAT TYPE=");
  691.     NEW_LINE;
  692.     FOR K IN V3'RANGE LOOP
  693.         PUT(V3(K));
  694.     END LOOP;
  695.  
  696. -- Vector of  enumerated type DAYS
  697.     NEW_LINE(2);
  698.     GET_VALUE(V4,V4VAL);
  699.     PUT("V4: VECTOR(3..5) OF ENUMERATED TYPE=");
  700.     NEW_LINE;
  701.     FOR K IN V4'RANGE LOOP
  702.         PUT(V4(K));PUT(" ");
  703.     END LOOP;
  704.  
  705.  
  706. -- 3x3 Matrix of floating point
  707.     NEW_LINE(2);
  708.     GET_VALUE(M1,M1VAL);
  709.     PUT("M1: MATRIX(3,3) OF FLOAT TYPE=");
  710.     NEW_LINE;
  711.     FOR K IN M1'RANGE(1) LOOP
  712.         PUT(M1(K,1));
  713.         PUT(M1(K,2));
  714.         PUT(M1(K,3));
  715.         NEW_LINE;
  716.     END LOOP;
  717.  
  718. -- 2x3 Matrix of floating point
  719.     NEW_LINE(2);
  720.     GET_VALUE(M2,M2VAL);
  721.     PUT("M2: MATRIX(2,3) OF FLOAT TYPE=");
  722.     NEW_LINE;
  723.     FOR K IN M2'RANGE(1) LOOP
  724.         PUT(M2(K,-1));
  725.         PUT(M2(K,0));
  726.         PUT(M2(K,1));
  727.         NEW_LINE;
  728.     END LOOP;
  729.  
  730. -- 2x2 Matrix of integer
  731.     NEW_LINE(2);
  732.     GET_VALUE(MI,MIVAL);
  733.     PUT("MI: MATRIX(2,2) OF INTEGER TYPE=");
  734.     NEW_LINE;
  735.     FOR K IN MI'RANGE(1) LOOP
  736.         PUT(MI(K,-1));
  737.         PUT(MI(K,0));
  738.         NEW_LINE;
  739.     END LOOP;
  740.  
  741. -- 2x3 Matrix of indexed by enumerated type DAYS of floating point
  742.     NEW_LINE(2);
  743.     GET_VALUE(M3,M3VAL);
  744.     PUT("M3: MATRIX(2,3) INDEX BY ENUMERATED TYPE; OF FLOAT TYPE=");
  745.     NEW_LINE;
  746.     FOR K IN M3'RANGE(1) LOOP
  747.         PUT(M3(K,WED));
  748.         PUT(M3(K,THUR));
  749.         PUT(M3(K,FRI));
  750.         NEW_LINE;
  751.     END LOOP;
  752.  
  753. -- 3x2 Matrix of type DAYS indexed by INTEGER
  754.     NEW_LINE(2);
  755.     GET_VALUE(M4,M4VAL);
  756.     PUT("M4: MATRIX(3,2)of ENUMERATED TYPE=");
  757.     NEW_LINE;
  758.     FOR K IN M4'RANGE(1) LOOP
  759.         PUT(M4(K,-1));PUT(" ");
  760.         PUT(M4(K,0));
  761.         NEW_LINE;
  762.     END LOOP;
  763.  
  764.     CLOSE(OUTFILE);
  765.  
  766. END TNL;
  767. ::::::::::
  768. test1.dat
  769. ::::::::::
  770.  
  771. -- TEST1.DAT  File to test capabilities of NAMELIST
  772.  
  773.      YVAL= 234234.0
  774.  
  775. -- Fixed point type
  776.  
  777.         FYVAL = 12.0
  778.  
  779. -- 5 Element vector 
  780.  V1VAL = 2.0,3.0,4.0,5.0,6.0
  781.  
  782. -- One element of vector
  783.     v12val = 12.0
  784.   IVAL = 9909
  785.     VACVAL = SAT
  786.  
  787.  
  788.     TITLE1VAL = "This is the first title"
  789. TITLE3VAL = "  ``single quotes'' 2 DOUBLE QUOTES " "  SDF    "
  790.  
  791. -- Vector Input
  792.  
  793.     V2VAL = 34.5,67.8,90.1
  794.  
  795.     v3val = 2.0,3.0,0.234,4.0,5.0  -- Vector indexed by enumerated type of floating
  796.  
  797.     v4val = FRI,FRI,SAT -- Vector of enumerated type
  798.  
  799. -- Matrix inputs
  800.  
  801.  
  802. -- FLOATING POINT MATRIX
  803. M1VAL(3,3)= 1.0,2.0,3.0, -- FIRST ROW
  804.         4.0,5.0,6.0,-- SECOND ROW
  805.         7.0,8.0,9.0 -- THIRD ROW
  806.  
  807. M2VAL(2,2)=    1.0,2.0,3.0,
  808.         4.0,5.0,6.0
  809.  
  810. -- INTEGER MATRIX
  811. MIVAL(2,2)= 11, 12,
  812.             13, 14
  813.  
  814.     M3VAL(2,3) = 123.45,2345.476,35.0,
  815.            123.45,2345.476,35.0
  816.  
  817.     M4VAL(3,2) =     MON,MON,
  818.                 TUES,TUES,
  819.                 SAT,SUN
  820.  
  821. -- End of File
  822. ::::::::::
  823. outnl.dat
  824. ::::::::::
  825.  
  826.  
  827. THIS IS A TEST: The following are the translated values
  828.  
  829. X:FLOAT TYPE= 0.00000E+00
  830.  
  831. Y: FLOAT TYPE= 2.34234E+05
  832.  
  833. FY: FIXED POINT  TYPE= 12.0
  834.  
  835. I: INTEGER TYPE=       9909
  836.  
  837. VAC: ENUMERATION TYPE=SAT
  838.  
  839. TITLE1(STRING(1..10))=This is th
  840.  
  841. TITLE2(STRING)(DEFAULT VALUE)= Whats your problem?!!
  842.  
  843. TITLE3: STRING(1..40)=  ``single quotes'' 2 DOUBLE QUOTES " " 
  844.  
  845. V1(2):ELEMENT OF VECTOR=
  846.  1.20000E+01
  847.  
  848. V1: VECTOR(1..5) OF FLOAT TYPE=
  849.  2.00000E+00 3.00000E+00 4.00000E+00 5.00000E+00 6.00000E+00
  850.  
  851. V2: VECTOR(-1..1) OF FLOAT TYPE=
  852.  3.45000E+01 6.78000E+01 9.01000E+01
  853.  
  854. V3: VECTOR(MON..FRI) OF FLOAT TYPE=
  855.  2.00000E+00 3.00000E+00 2.34000E-01 4.00000E+00 5.00000E+00
  856.  
  857. V4: VECTOR(3..5) OF ENUMERATED TYPE=
  858. FRI FRI SAT 
  859.  
  860. M1: MATRIX(3,3) OF FLOAT TYPE=
  861.  1.00000E+00 2.00000E+00 3.00000E+00
  862.  4.00000E+00 5.00000E+00 6.00000E+00
  863.  7.00000E+00 8.00000E+00 9.00000E+00
  864.  
  865.  
  866. M2: MATRIX(2,3) OF FLOAT TYPE=
  867.  1.00000E+00 2.00000E+00 3.00000E+00
  868.  4.00000E+00 5.00000E+00 6.00000E+00
  869.  
  870.  
  871. MI: MATRIX(2,2) OF INTEGER TYPE=
  872.          11         12
  873.          13         14
  874.  
  875.  
  876. M3: MATRIX(2,3) INDEX BY ENUMERATED TYPE; OF FLOAT TYPE=
  877.  1.23450E+02 2.34548E+03 3.50000E+01
  878.  1.23450E+02 2.34548E+03 3.50000E+01
  879.  
  880.  
  881. M4: MATRIX(3,2)of ENUMERATED TYPE=
  882. MON MON
  883. TUES TUES
  884. SAT SUN
  885.